home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / 1.6.0 / ice-9 / documentation.scm < prev    next >
Encoding:
Text File  |  2004-01-06  |  8.6 KB  |  228 lines
  1. ;;;;     Copyright (C) 2000,2001 Free Software Foundation, Inc.
  2. ;;;;
  3. ;;;; This program is free software; you can redistribute it and/or modify
  4. ;;;; it under the terms of the GNU General Public License as published by
  5. ;;;; the Free Software Foundation; either version 2, or (at your option)
  6. ;;;; any later version.
  7. ;;;;
  8. ;;;; This program is distributed in the hope that it will be useful,
  9. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. ;;;; GNU General Public License for more details.
  12. ;;;;
  13. ;;;; You should have received a copy of the GNU General Public License
  14. ;;;; along with this software; see the file COPYING.  If not, write to
  15. ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16. ;;;; Boston, MA 02111-1307 USA
  17. ;;;;
  18. ;;;; As a special exception, the Free Software Foundation gives permission
  19. ;;;; for additional uses of the text contained in its release of GUILE.
  20. ;;;;
  21. ;;;; The exception is that, if you link the GUILE library with other files
  22. ;;;; to produce an executable, this does not by itself cause the
  23. ;;;; resulting executable to be covered by the GNU General Public License.
  24. ;;;; Your use of that executable is in no way restricted on account of
  25. ;;;; linking the GUILE library code into it.
  26. ;;;;
  27. ;;;; This exception does not however invalidate any other reasons why
  28. ;;;; the executable file might be covered by the GNU General Public License.
  29. ;;;;
  30. ;;;; This exception applies only to the code released by the
  31. ;;;; Free Software Foundation under the name GUILE.  If you copy
  32. ;;;; code from other Free Software Foundation releases into a copy of
  33. ;;;; GUILE, as the General Public License permits, the exception does
  34. ;;;; not apply to the code that you add in this way.  To avoid misleading
  35. ;;;; anyone as to the status of such modified files, you must delete
  36. ;;;; this exception notice from them.
  37. ;;;;
  38. ;;;; If you write modifications of your own for GUILE, it is your choice
  39. ;;;; whether to permit this exception to apply to your modifications.
  40. ;;;; If you do not wish that, delete this exception notice.
  41. ;;;;
  42.  
  43. ;;; Commentary:
  44.  
  45. ;; * This module exports:
  46. ;;
  47. ;; file-commentary      -- a procedure that returns a file's "commentary"
  48. ;;
  49. ;; documentation-files  -- a search-list of files using the Guile
  50. ;;                         Documentation Format Version 2.
  51. ;;
  52. ;; search-documentation-files -- a procedure that takes NAME (a symbol)
  53. ;;                               and searches `documentation-files' for
  54. ;;                               associated documentation.  optional
  55. ;;                               arg FILES is a list of filenames to use
  56. ;;                               instead of `documentation-files'.
  57. ;;
  58. ;; object-documentation -- a procedure that returns its arg's docstring
  59. ;;
  60. ;; * Guile Documentation Format
  61. ;;
  62. ;; Here is the complete and authoritative documentation for the Guile
  63. ;; Documentation Format Version 2:
  64. ;;
  65. ;; HEADER
  66. ;; ^LPROC1
  67. ;; DOCUMENTATION1
  68. ;;
  69. ;; ^LPROC2
  70. ;; DOCUMENTATION2
  71. ;;
  72. ;; ^L...
  73. ;;
  74. ;; The HEADER is completely ignored.  The "^L" are formfeeds.  PROC1, PROC2
  75. ;; and so on are symbols that name the element documented.  DOCUMENTATION1,
  76. ;; DOCUMENTATION2 and so on are the related documentation, w/o any further
  77. ;; formatting.  Note that there are two newlines before the next formfeed;
  78. ;; these are discarded when the documentation is read in.
  79. ;;
  80. ;; (Version 1, corresponding to guile-1.4 and prior, is documented as being
  81. ;; not documented anywhere except by this embarrassingly circular comment.)
  82. ;;
  83. ;; * File Commentary
  84. ;;
  85. ;; A file's commentary is the body of text found between comments
  86. ;;     ;;; Commentary:
  87. ;; and
  88. ;;     ;;; Code:
  89. ;; both of which must be at the beginning of the line.  In the result string,
  90. ;; semicolons at the beginning of each line are discarded.
  91. ;;
  92. ;; You can specify to `file-commentary' alternate begin and end strings, and
  93. ;; scrub procedure.  Use #t to get default values.  For example:
  94. ;;
  95. ;; (file-commentary "documentation.scm")
  96. ;; You should see this text!
  97. ;;
  98. ;; (file-commentary "documentation.scm" "^;;; Code:" "ends here$")
  99. ;; You should see the rest of this file.
  100. ;;
  101. ;; (file-commentary "documentation.scm" #t #t string-upcase)
  102. ;; You should see this text very loudly (note semicolons untouched).
  103.  
  104. ;;; Code:
  105.  
  106. (define-module (ice-9 documentation)
  107.   :use-module (ice-9 rdelim)
  108.   :export (file-commentary
  109.            documentation-files search-documentation-files
  110.            object-documentation)
  111.   :autoload (ice-9 regex) (match:suffix)
  112.   :no-backtrace)
  113.  
  114.  
  115. ;;
  116. ;; commentary extraction
  117. ;;
  118. (define default-in-line-re (make-regexp "^;;; Commentary:"))
  119. (define default-after-line-re (make-regexp "^;;; Code:"))
  120. (define default-scrub (let ((dirt (make-regexp "^;+")))
  121.                         (lambda (line)
  122.                           (let ((m (regexp-exec dirt line)))
  123.                             (if m (match:suffix m) line)))))
  124.  
  125. (define (file-commentary filename . cust) ; (IN-LINE-RE AFTER-LINE-RE SCRUB)
  126.   ;; fixme: might be cleaner to use optargs here...
  127.   (let ((in-line-re (if (> 1 (length cust))
  128.                         default-in-line-re
  129.                         (let ((v (car cust)))
  130.                           (cond ((regexp? v) v)
  131.                                 ((string? v) (make-regexp v))
  132.                                 (else default-in-line-re)))))
  133.         (after-line-re (if (> 2 (length cust))
  134.                            default-after-line-re
  135.                            (let ((v (cadr cust)))
  136.                              (cond ((regexp? v) v)
  137.                                    ((string? v) (make-regexp v))
  138.                                    (else default-after-line-re)))))
  139.         (scrub (if (> 3 (length cust))
  140.                    default-scrub
  141.                    (let ((v (caddr cust)))
  142.                      (cond ((procedure? v) v)
  143.                            (else default-scrub)))))
  144.         (port (open-input-file filename)))
  145.     (let loop ((line (read-delimited "\n" port))
  146.                (doc "")
  147.                (parse-state 'before))
  148.       (if (or (eof-object? line) (eq? 'after parse-state))
  149.           doc
  150.           (let ((new-state
  151.                  (cond ((regexp-exec in-line-re line) 'in)
  152.                        ((regexp-exec after-line-re line) 'after)
  153.                        (else parse-state))))
  154.             (if (eq? 'after new-state)
  155.                 doc
  156.                 (loop (read-delimited "\n" port)
  157.                       (if (and (eq? 'in new-state) (eq? 'in parse-state))
  158.                           (string-append doc (scrub line) "\n")
  159.                           doc)
  160.                       new-state)))))))
  161.  
  162.  
  163.  
  164. ;;
  165. ;; documentation-files is the list of places to look for documentation
  166. ;;
  167. (define documentation-files
  168.   (map (lambda (vicinity)
  169.      (in-vicinity (vicinity) "guile-procedures.txt"))
  170.        (list %library-dir
  171.          %package-data-dir
  172.          %site-dir
  173.          (lambda () "."))))
  174.  
  175. (define entry-delimiter "\f")
  176.  
  177. (define (find-documentation-in-file name file)
  178.   (and (file-exists? file)
  179.        (let ((port (open-input-file file))
  180.          (name (symbol->string name)))
  181.      (let ((len (string-length name)))
  182.        (read-delimited entry-delimiter port) ;skip to first entry
  183.        (let loop ((entry (read-delimited entry-delimiter port)))
  184.          (cond ((eof-object? entry) #f)
  185.            ;; match?
  186.            ((and ;; large enough?
  187.                  (>= (string-length entry) len)
  188.              ;; matching name?
  189.              (string=? (substring entry 0 len) name)
  190.              ;; terminated?
  191.              (memq (string-ref entry len) '(#\newline)))
  192.             ;; cut away name tag and extra surrounding newlines
  193.             (substring entry (+ len 2) (- (string-length entry) 2)))
  194.            (else (loop (read-delimited entry-delimiter port)))))))))
  195.  
  196. (define (search-documentation-files name . files)
  197.   (or-map (lambda (file)
  198.         (find-documentation-in-file name file))
  199.           (cond ((null? files) documentation-files)
  200.                 (else files))))
  201.  
  202. ;; helper until the procedure documentation property is cleaned up
  203. (define (proc-doc proc)
  204.   (or (procedure-documentation proc)
  205.       (procedure-property proc 'documentation)))
  206.  
  207. (define (object-documentation object)
  208.   "Return the docstring for OBJECT.
  209. OBJECT can be a procedure, macro or any object that has its
  210. `documentation' property set."
  211.   (or (and (procedure? object)
  212.        (proc-doc object))
  213.       (and (macro? object)
  214.        (let ((transformer (macro-transformer object)))
  215.          (and transformer
  216.           (proc-doc transformer))))
  217.       (object-property object 'documentation)
  218.       (and (procedure? object)
  219.        (not (closure? object))
  220.        (procedure-name object)
  221.        (let ((docstring (search-documentation-files
  222.                              (procedure-name object))))
  223.          (if docstring
  224.          (set-procedure-property! object 'documentation docstring))
  225.          docstring))))
  226.  
  227. ;;; documentation.scm ends here
  228.